home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / RESDMP11 / DRESFU.PAS next >
Pascal/Delphi Source File  |  1993-07-27  |  37KB  |  995 lines
  1. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O-,R+,S+,V+,X+,Y-}
  2.  
  3. { dump resource file written by RESEDIT,
  4.   W. Gross, 6-APR-92, Last change: 16-JUN-93
  5.  
  6.   DumpWhat :  A=all, D=TDialog, S=TStringList, M=TMenuBar, F=Focused item
  7.   ItemKEy  :  key of item (if DumpWhat = F)
  8.   outfile  : output file
  9.   resfile  : TResourceFile
  10.   StreamErrorOccured : return true, if this happens (unregistered obj.)
  11.  
  12.  
  13.   Handles only objects
  14.      TMenuBar, TStringList, TStatusLine and
  15.      TDialog with these controls:
  16.          TView, TButton, TRadioButton, TCheckBoxes, THistory,
  17.          TInputLine, TParamText, TListViewer, TStaticText
  18.  
  19.   Program should recover from stream errors, but output is incomplete
  20.   and the heap might be unclean afterwards.
  21.  
  22. }
  23.  
  24. UNIT DResFU;
  25.  
  26. INTERFACE
  27.   USES objects;
  28.  
  29.  
  30.   PROCEDURE DumpIt ( DumpWhat    : char;
  31.                      ItemKey     : String;
  32.                      VAR outfile : text;
  33.                      VAR ResFile : TResourceFile;
  34.                      VAR StreamErrorOccured : boolean);
  35.  
  36.  
  37.  
  38. IMPLEMENTATION
  39.   uses dos, drivers, views, dialogs, menus, stddlg, msgbox,RESDUTIL;
  40.  
  41.  
  42. TYPE TLine   = ARRAY[0..80] OF char;
  43.      TScreen = Array[0..25] OF TLine;
  44.  
  45. VAR ownlabel,LinkZ : integer;
  46.     LabelLink,HistoryLink : PView;
  47.  
  48.  
  49. PROCEDURE DumpIt ( DumpWhat    : char;
  50.                    ItemKey     : String;
  51.                    VAR outfile : text;
  52.                    VAR ResFile : TResourceFile;
  53.                    VAR StreamErrorOccured : boolean);
  54.  
  55. VAR  MyObj         : PObject;
  56.      FName, Key, s : String;
  57.      s15           : String[15];
  58.      TOM, TOD, TOS, TOSL : Pointer;
  59.      i, StreamStatus, StreamInfo : integer;
  60.  
  61.      MB  : PMenuBar;
  62.      DB  : PDialog;
  63.      PMI : PMenuItem;
  64.  
  65.      Screen : TScreen;
  66.  
  67.  
  68.   FUNCTION Hex(w:word) : String;
  69.     VAR s : String; l : longint;
  70.     BEGIN
  71.       l := longint(w);
  72.       FormatStr(s,'$%04x',l);
  73.       Hex := s;
  74.     END;
  75.  
  76.   PROCEDURE PutBar ( Orig,Size :TPoint);
  77.     VAR i,j : integer;
  78.     BEGIN
  79.       FOR i := Orig.X TO Orig.X+Size.X-1 DO
  80.         FOR j := Orig.Y TO Orig.Y+Size.Y-1 DO
  81.           Screen[j,i] := '▓';
  82.     END;
  83.  
  84.   PROCEDURE PutHatch ( Orig,Size :TPoint);
  85.     VAR i,j : integer;
  86.     BEGIN
  87.       FOR i := Orig.X TO Orig.X+Size.X-1 DO
  88.         FOR j := Orig.Y TO Orig.Y+Size.Y-1 DO
  89.           Screen[j,i] := '░';
  90.     END;
  91.  
  92.   PROCEDURE PutShadow ( Orig,Size :TPoint);
  93.     VAR i,j : integer;
  94.     BEGIN
  95.       j := Orig.Y+Size.Y-1; Screen[j,Orig.X] := ' ';
  96.       FOR i := Orig.X+1 TO Orig.X+Size.X-1 DO Screen[j,i] := '▀';
  97.       i := Orig.X+Size.X-1; Screen[Orig.Y,i] := '▄';
  98.       FOR j := Orig.Y+1 TO Orig.Y+Size.Y-2 DO Screen[j,i] := '█';
  99.     END;
  100.  
  101.   PROCEDURE PutFrame(Orig,Size : TPoint; Title : PString);
  102.     {put frame only on blank area}
  103.     VAR i,l,l2 : integer;
  104.     BEGIN
  105.       FOR i := 2 TO Size.X-1 DO
  106.         BEGIN
  107.           IF (Screen[Orig.Y,Orig.X+i-1]=' ') THEN
  108.             Screen[Orig.Y,Orig.X+i-1] := '─';
  109.           IF (Screen[Orig.Y+Size.Y-1,Orig.X+i-1]=' ') THEN
  110.             Screen[Orig.Y+Size.Y-1,Orig.X+i-1] := '─';
  111.         END;
  112.       FOR i := 2 TO Size.Y-1 DO
  113.         BEGIN
  114.           IF (Screen[Orig.Y+i-1,Orig.X]=' ') THEN
  115.             Screen[Orig.Y+i-1,Orig.X] := '│';
  116.           IF (Screen[Orig.Y+i-1,Orig.X+Size.X-1]=' ') THEN
  117.             Screen[Orig.Y+i-1,Orig.X+Size.X-1] := '│';
  118.         END;
  119.       IF (Screen[Orig.Y,Orig.X]=' ') THEN
  120.         Screen[Orig.Y,Orig.X] := '┌';
  121.       IF (Screen[Orig.Y,Orig.X+Size.X-1]=' ') THEN
  122.         Screen[Orig.Y,Orig.X+Size.X-1] := '┐';
  123.       IF (Screen[Orig.Y+Size.Y-1,Orig.X]=' ') THEN
  124.         Screen[Orig.Y+Size.Y-1,Orig.X] := '└';
  125.       IF (Screen[Orig.Y+Size.Y-1,Orig.X+Size.X-1]=' ') THEN
  126.         Screen[Orig.Y+Size.Y-1,Orig.X+Size.X-1] := '┘';
  127.  
  128.       IF Title<>NIL THEN
  129.         BEGIN
  130.           l := Length(Title^); l2 := (Size.X-l) DIV 2;
  131.           FOR i := 1 TO l DO
  132.             Screen[Orig.Y, Orig.X+l2+i-1] := Title^[i];
  133.         END;
  134.     END; {PROC PutFrame}
  135.  
  136.     FUNCTION TrimText ( s : String ) : String;
  137.       VAR p : integer;
  138.       BEGIN
  139.         WHILE pos ( #3, s )>0 DO
  140.           BEGIN
  141.             p := pos ( #3, s ); delete ( s, p, 1 );
  142.             insert ( '^C', s, p );
  143.           END;
  144.         WHILE pos ( #10, s )>0 DO
  145.           BEGIN
  146.             p := pos ( #10, s ); delete ( s, p, 1 );
  147.             insert ( '^J', s, p );
  148.           END;
  149.         WHILE pos ( #13, s )>0 DO
  150.           BEGIN
  151.             p := pos ( #13, s ); delete ( s, p, 1 );
  152.             insert ( '^M', s, p );
  153.           END;
  154.         TrimText := s;
  155.       END;
  156.  
  157.   PROCEDURE WrapText(s:String;pos:integer);
  158.     {write string from current line position, wrap text beyond
  159.      col 80 to next line using the same indentation}
  160.     VAR sh : String; j,l,li,ld : integer;
  161.     BEGIN
  162.       s := TrimText(s);
  163.       WHILE (length(s)>0) DO
  164.         BEGIN
  165.           l := 80-pos;
  166.           IF (length(s)<=l)
  167.             THEN BEGIN li := length(s); ld := li  END
  168.             ELSE
  169.               IF (s[l+1]=' ')
  170.                 THEN BEGIN li := l; ld := l+1; END
  171.                 ELSE
  172.                   BEGIN
  173.                     j := l; {search for blank}
  174.                     WHILE (j>=1) AND (s[j]<>' ') DO Dec(j);
  175.                     IF j=0
  176.                       THEN BEGIN li := l; ld := l END  {too long anyway}
  177.                       ELSE BEGIN li := j-1; ld := j  END;  {wrap around}
  178.                   END;
  179.           sh := copy (s, 1, li ); delete ( s, 1, ld );
  180.           writeln ( outfile, sh );
  181.           IF (length(s)>0) THEN write ( outfile, ' ':pos);
  182.         END;
  183.     END;{PROC WrapText}
  184.  
  185.  
  186.   PROCEDURE ProcessDialogB ( DB : PDialog );
  187.     VAR i,j,l,l2 : integer;
  188.         DBOrig,DBSize : TPoint;
  189.         TypeOfDesc : Pointer;
  190.  
  191.     PROCEDURE InsertStaticText ( STO, STS : TPoint; s : String );
  192.       VAR i,j,j0,l,l2,li,ld, maxi, p : integer;
  193.           CRencountered, centered : boolean;
  194.           line : String;
  195.       BEGIN
  196.         i := 0; maxi := STS.Y;
  197.         REPEAT
  198.           p := pos ('~',s);
  199.           IF (p>0) THEN delete(s,p,1);
  200.         UNTIL (p=0);
  201.         l := STS.X;
  202.         CRencountered := true; {tricky initial setting}
  203.  
  204.         WHILE (i<maxi) AND (s<>'') DO
  205.           BEGIN
  206.             Inc(i);
  207.             IF CRencountered THEN  {last char processed was CR}
  208.               BEGIN
  209.                 centered := (s[1] = #3);
  210.                 IF centered THEN delete (s,1,1);
  211.               END;
  212.             CRencountered := false;
  213.             {^M hier erledigen}
  214.             p := pos ( #13, s );
  215.             IF (p>0) AND ((p-1)<=l)
  216.               THEN {text up to next ^M fits into line}
  217.                 BEGIN
  218.                   line := copy ( s, 1, p-1 ); delete ( s, 1, p );
  219.                   CRencountered := true;
  220.                 END
  221.               ELSE
  222.                 IF length(s)<=l
  223.                   THEN BEGIN line := s; s := ''; END
  224.                   ELSE
  225.                    BEGIN
  226.                     IF (s[l+1]=' ') OR (i=maxi) {doesn't fit anyway}
  227.                       THEN BEGIN li := l; ld := l+1; END
  228.                       ELSE
  229.                         BEGIN
  230.                           j := l; {search for blank}
  231.                           WHILE (j>=1) AND (s[j]<>' ') DO Dec(j);
  232.                           IF j=0
  233.                             THEN BEGIN li := l; ld := l END {too long anyway}
  234.                             ELSE BEGIN li := j-1; ld := j  END; {wrap around}
  235.                         END;
  236.                       line := copy (s, 1, li ); delete ( s, 1, ld );
  237.                    END;
  238.  
  239.             IF NOT CREncountered THEN {wrap around in progress}
  240.               WHILE (s<>'') AND (s[1]=' ') DO delete ( s, 1, 1);
  241.  
  242.             j0 := 1;
  243.             IF centered THEN
  244.               BEGIN
  245.                 WHILE (length(line)>=1) AND (line[length(line)]=' ') DO
  246.                   delete(line, length(line),1);
  247.                 l2 := length(line); j := (l-l2) DIV 2; j0 := j+1;
  248.                 WHILE (j>=1) DO  BEGIN  line := ' '+line; dec(j);  END;
  249.               END;
  250.  
  251.             FOR j := j0 TO length(line) DO
  252.               Screen[DBOrig.Y+STO.Y+i-1, DBOrig.X+STO.X+j-1] := line[j];
  253.  
  254.           END; {WHILE (i<maxi) AND ... }
  255.  
  256.       END; {InsertStaticText}
  257.  
  258.  
  259.     PROCEDURE WriteButton ( P : PView ) ; far;
  260.       VAR i : integer; sh : String; VO,VOS : TPoint;
  261.       BEGIN
  262.         ownlabel := ownlabel+1;
  263.         IF TypeOf(P^)=TypeOf(TButton) THEN
  264.           WITH PButton(P)^ DO
  265.             BEGIN
  266.               writeln ( outfile, ownlabel:3, ': ',
  267.                         '(', Origin.X:2, ',', Origin.Y:2, ') (',
  268.                         Size.X:2, ',', Size.Y:2, ') ',
  269.                         Command:5, ' ', HelpCtx:5, ' ', hex(flags):5, ' ',
  270.                         hex(options):6, '  [', Title^, ']'  );
  271.               VO.X := DBOrig.X+Origin.X+1; VO.Y := DBOrig.Y+Origin.Y;
  272.               VOS.X := Size.X-1; VOS.Y := Size.Y;
  273.               PutHatch ( VO, VOS );
  274.               PutShadow ( VO, VOS );
  275.               sh := Title^;
  276.               IF (flags AND bfLeftJust)=0 THEN sh := #3+sh;
  277.               VO.X := Origin.X+1;
  278.               VO.Y := Origin.Y+(VOS.Y DIV 2)-1; VOS.Y := 2;
  279.               InsertStaticText ( VO, VOS, sh );
  280.             END;
  281.       END;
  282.  
  283.     PROCEDURE WriteCluster ( P : PView ) ; far;
  284.       {called by WriteRadioButtons or WriteCheckBoxes,
  285.        nonlocal: ownlabel}
  286.       VAR i,l,linkz,NoOfLines,NextItem,NoOfItemsPerColumn : integer;
  287.           sh : String;
  288.           NewOrig,LO,SI : TPoint;
  289.           DV : PView;
  290.           IsRButton : boolean;
  291.           PS : PString;
  292.       FUNCTION TestLabel(View : PView) : boolean;far;
  293.         {use this in a FirstThat call to obtain the label which is
  294.          linked to this view, side effect for LinkZ !!!}
  295.         BEGIN
  296.           Inc(LinkZ);
  297.           if (TypeOf(View^) = TypeOf(TLabel)) and
  298.             (PLabel(View)^.Link = P) then
  299.                begin TestLabel := True; Exit; end;
  300.           TestLabel := False;
  301.         END;
  302.       FUNCTION Min ( a,b : integer ) : integer;
  303.         BEGIN
  304.           IF a<b THEN Min := a ELSE Min := b;
  305.         END;
  306.       BEGIN
  307.         linkz := 0;
  308.           WITH PCluster(P)^ DO
  309.             BEGIN
  310.               IsRButton := TypeOf(P^)=TypeOf(TRadioButtons);
  311.               write ( outfile,  ownlabel:3, ': ',
  312.                         '(', Origin.X:2, ',', Origin.Y:2, ') (',
  313.                         Size.X:2, ',',  Size.Y:2, ') ',
  314.                         HelpCtx:5, ' ', hex(options):6, ' ' );
  315.               IF IsRButton THEN write ( outfile, value:5, '  ' )
  316.                            ELSE write ( outfile, hex(value):6, ' ' );
  317.               DV := DB^.FirstThat(@TestLabel);{side effect for LinkZ}
  318.               IF DV<>NIL THEN write ( outfile, LinkZ:4, '  ' )
  319.                          ELSE write ( outfile, '      ');
  320.               sh := '';
  321.               IF (Options AND ofFramed)=ofFramed THEN
  322.                 BEGIN
  323.                   LO.X := DBOrig.X+Origin.X-1;
  324.                   LO.Y := DBOrig.Y+Origin.Y-1;
  325.                   SI.X := Size.X+2; SI.Y := Size.Y+2;
  326.                   PutFrame ( LO, SI, nil);
  327.                 END;
  328.               WITH Strings DO
  329.                 BEGIN
  330.                   NoOfLines := Size.Y; NewOrig := Origin;
  331.                   NextItem := 0;
  332.                   REPEAT
  333.                     NoOfItemsPerColumn := Min ( NoOfLines, count-NextItem);
  334.                     l := 0; sh := '';
  335.                     FOR i := NextItem TO NextItem+NoOfItemsPerColumn-1 DO
  336.                       BEGIN
  337.                         PS := PString(Items^[i]);
  338.                         writeln ( outfile, PS^ );
  339.                         IF length(PS^) > l THEN l := Length(PS^);
  340.                         IF IsRButton
  341.                           THEN
  342.                             BEGIN
  343.                               IF value=i THEN sh := sh + ' (∙) '
  344.                                          ELSE sh := sh + ' ( ) ';
  345.                             END
  346.                           ELSE
  347.                             BEGIN
  348.                              IF ((value shr i) AND 1)=1
  349.                                THEN sh := sh+' [x] ' ELSE sh := sh+ ' [ ] ';
  350.                             END;
  351.                         sh := sh+PString(Items^[i])^;
  352.                         IF i<count-1 THEN
  353.                           BEGIN
  354.                             write ( outfile,  ' ':47 ); sh := sh+#13;
  355.                           END;
  356.                       END; {FOR i := NextItem ...       }
  357.                     InsertStaticText ( NewOrig, Size, sh );
  358.                     NewOrig.X := NewOrig.X+l+6;
  359.                     NextItem := NextItem+NoOfItemsPerColumn;
  360.                   UNTIL (NextItem > (count-1));
  361.                 END; {WITH Strings DO ...}
  362.             END; {WITH PCluster(P)^ DO ...}
  363.       END;
  364.  
  365.     PROCEDURE WriteRadioButtons ( P : PView ) ; far;
  366.       BEGIN
  367.         ownlabel := ownlabel+1;
  368.         IF (TypeOf(P^)=TypeOf(TRadioButtons)) THEN WriteCluster(P);
  369.       END;
  370.  
  371.     PROCEDURE WriteCheckBoxes ( P : PView ) ; far;
  372.       BEGIN
  373.         ownlabel := ownlabel+1;
  374.         IF (TypeOf(P^)=TypeOf(TCheckBoxes)) THEN WriteCluster(P);
  375.       END;
  376.  
  377.     PROCEDURE WriteStaticText ( P : PView ) ; far;
  378.       VAR i : integer; sh : String; LO, SI : TPoint;
  379.       BEGIN
  380.         ownlabel := ownlabel+1;
  381.         IF TypeOf(P^)=TypeOf(TStaticText) THEN
  382.           WITH PStaticText(P)^ DO
  383.             BEGIN
  384.               sh := TrimText(Text^);
  385.               write ( outfile, ownlabel:3, ': ',
  386.                       '(', Origin.X:2, ',', Origin.Y:2, ') (',
  387.                       Size.X:2, ',', Size.Y:2, ') ', hex(options):6, '  ');
  388.               IF (Options AND ofFramed)=ofFramed THEN
  389.                 BEGIN
  390.                   LO.X := DBOrig.X+Origin.X-1;
  391.                   LO.Y := DBOrig.Y+Origin.Y-1;
  392.                   SI.X := Size.X+2; SI.Y := Size.Y+2;
  393.                   PutFrame ( LO, SI, nil);
  394.                 END;
  395.               WrapText(sh,29);
  396.               InsertStaticText ( Origin, Size, Text^ );
  397.             END;
  398.       END;
  399.  
  400.     PROCEDURE WriteParamText ( P : PView ) ; far;
  401.       VAR i : integer; sh : String; LO, SI : TPoint;
  402.       BEGIN
  403.         ownlabel := ownlabel+1;
  404.         IF TypeOf(P^)=TypeOf(TParamText) THEN
  405.           WITH PParamText(P)^ DO
  406.             BEGIN
  407.               sh := TrimText(Text^);
  408.               write ( outfile, ownlabel:3, ': ',
  409.                       '(', Origin.X:2, ',', Origin.Y:2, ') (',
  410.                       Size.X:2, ',', Size.Y:2, ') ', hex(options):6,
  411.                       '    ', ParamCount:2, '  ');
  412.               IF (Options AND ofFramed)=ofFramed THEN
  413.                 BEGIN
  414.                   LO.X := DBOrig.X+Origin.X-1;
  415.                   LO.Y := DBOrig.Y+Origin.Y-1;
  416.                   SI.X := Size.X+2; SI.Y := Size.Y+2;
  417.                   PutFrame ( LO, SI, nil);
  418.                 END;
  419.               WrapText(sh,35);
  420.               InsertStaticText ( Origin, Size, Text^ );
  421.             END;
  422.       END;
  423.  
  424.     PROCEDURE WriteLabel ( P : PView ) ; far;
  425.       VAR i : integer; sh : String; DV : PView;
  426.       FUNCTION TestLink(View : PView) : boolean;far;
  427.         {use this in a FirstThat call to obtain the view the label
  428.          is linked to}
  429.         BEGIN
  430.           Inc(LinkZ); TestLink := (View=LabelLink);
  431.         END;
  432.       BEGIN
  433.         ownlabel := ownlabel+1;
  434.         IF TypeOf(P^)=TypeOf(TLabel) THEN
  435.           WITH PLabel(P)^ DO
  436.             BEGIN
  437.               sh := TrimText(Text^);
  438.               LinkZ := 0; LabelLink := PLabel(P)^.Link;
  439.               DV := DB^.FirstThat(@TestLink);{side effect for LinkZ}
  440.               IF DV=nil THEN LinkZ:=0;
  441.               writeln ( outfile, ownlabel:3, ': ',
  442.                         '(', Origin.X:2, ',', Origin.Y:2, ') (',
  443.                         Size.X:2, ',',  Size.Y:2, ') ',
  444.                         hex(options):6, '  ', LinkZ:3, '  ', sh );
  445.               {labels have leading blank, don't ask me why}
  446.               InsertStaticText ( Origin, Size, ' '+Text^ );
  447.             END;
  448.       END;
  449.  
  450.     PROCEDURE WriteHistory ( P : PView ) ; far;
  451.       VAR i : integer; sh : String; DV : PView;
  452.       FUNCTION TestLink(View : PView) : boolean;far;
  453.         {use this in a FirstThat call to obtain the view the label
  454.          is linked to}
  455.         BEGIN
  456.           Inc(LinkZ); TestLink := (View=HistoryLink);
  457.         END;
  458.       BEGIN
  459.         ownlabel := ownlabel+1;
  460.         IF TypeOf(P^)=TypeOf(THistory) THEN
  461.           WITH PHistory(P)^ DO
  462.             BEGIN
  463.               LinkZ := 0; HistoryLink := PHistory(P)^.Link;
  464.               DV := DB^.FirstThat(@TestLink);{side effect for LinkZ}
  465.               IF DV=nil THEN LinkZ:=0;
  466.               writeln ( outfile, ownlabel:3, ': ',
  467.                         '(', Origin.X:2, ',', Origin.Y:2, ') (',
  468.                         Size.X:2, ',',  Size.Y:2, ') ',
  469.                         hex(options):6, '  ', HistoryID:4, '  ', LinkZ:4 );
  470.               InsertStaticText ( Origin, Size, ' |' );
  471.             END;
  472.       END;
  473.  
  474.     PROCEDURE WriteInputLine ( P : PView ) ; far;
  475.       VAR i,LinkZ : integer; DV : PView; LO,SI : TPoint;
  476.       FUNCTION TestLabel(View : PView) : boolean;far;
  477.         {use this in a FirstThat call to obtain the label which is
  478.          linked to this view, side effect for LinkZ !!!}
  479.         BEGIN
  480.           Inc(LinkZ);
  481.           if (TypeOf(View^) = TypeOf(TLabel)) and
  482.             (PLabel(View)^.Link = P) then
  483.                begin TestLabel := True; Exit; end;
  484.           TestLabel := False;
  485.         END;
  486.       FUNCTION TestHistory(View : PView) : boolean;far;
  487.         {use this in a FirstThat call to obtain the history object which is
  488.          linked to this view, side effect for LinkZ !!!}
  489.         BEGIN
  490.           Inc(LinkZ);
  491.           if (TypeOf(View^) = TypeOf(THistory)) and
  492.             (PHistory(View)^.Link = PInputLine(p)) then
  493.                begin TestHistory := True; Exit; end;
  494.           TestHistory := False;
  495.         END;
  496.       BEGIN
  497.         ownlabel := ownlabel+1;
  498.         IF TypeOf(P^)=TypeOf(TInputLine) THEN
  499.           WITH PInputLine(P)^ DO
  500.             BEGIN
  501.               write ( outfile, ownlabel:3, ': ',
  502.                       '(', Origin.X:2, ',', Origin.Y:2, ') (',
  503.                       Size.X:2, ',',  Size.Y:2, ') ',
  504.                       HelpCtx:5,  ' ', hex(options):6, ' ', MaxLen:6, '   ');
  505.               IF (Options AND ofFramed)=ofFramed THEN
  506.                 BEGIN
  507.                   LO.X := DBOrig.X+Origin.X-1;
  508.                   LO.Y := DBOrig.Y+Origin.Y-1;
  509.                   SI.X := Size.X+2; SI.Y := Size.Y+2;
  510.                   PutFrame ( LO, SI, nil);
  511.                 END;
  512.               LinkZ := 0;
  513.               DV := DB^.FirstThat(@TestLabel);{side effect for LinkZ}
  514.               IF DV<>NIL THEN write ( outfile, LinkZ:4, '   ' )
  515.                          ELSE write ( outfile, '       ' );
  516.               LinkZ := 0;
  517.               DV := DB^.FirstThat(@TestHistory);{side effect for LinkZ}
  518.               IF DV<>NIL THEN writeln ( outfile, LinkZ:4 )
  519.                          ELSE writeln ( outfile );
  520.               FOR i := 1 TO Size.X DO
  521.                 Screen[DBOrig.Y+Origin.Y,DBOrig.X+Origin.X+i-1] := '_';
  522.             END;
  523.       END;
  524.  
  525.     PROCEDURE WriteListViewer ( P : PView) ; far;
  526.       {for TListViewer and its descendants TListBox, TSortedListBox,
  527.       nonlocal TypeOfDesc}
  528.       VAR i,LinkZ : integer;
  529.           sb : String;
  530.           LO,BO,SI :TPoint;
  531.           DV : PView;
  532.       FUNCTION TestLabel(View : PView) : boolean;far;
  533.         {use this in a FirstThat call to obtain the label which is
  534.          linked to this view, side effect for LinkZ !!!}
  535.         BEGIN
  536.           Inc(LinkZ);
  537.           if (TypeOf(View^) = TypeOf(TLabel)) and
  538.             (PLabel(View)^.Link = P) then
  539.                begin TestLabel := True; Exit; end;
  540.           TestLabel := False;
  541.         END;
  542.       BEGIN
  543.         ownlabel := ownlabel+1; LinkZ := 0;
  544.         IF TypeOf(P^)=TypeOfDesc THEN
  545.           WITH PListViewer(P)^ DO
  546.             BEGIN
  547.               sb := ''; IF HScrollBar<>NIL THEN sb := 'H';
  548.               IF VScrollBar<>NIL THEN sb := sb+'V';
  549.               write ( outfile, ownlabel:3, ': ',
  550.                       '(', Origin.X:2, ',', Origin.Y:2, ') (',
  551.                       Size.X:2, ',',  Size.Y:2, ') ',
  552.                       HelpCtx:5, ' ', hex(options):6, '  ', sb:6, '  ' );
  553.               DV := DB^.FirstThat(@TestLabel);{side effect for LinkZ}
  554.               IF DV<>NIL THEN writeln ( outfile, LinkZ:4 )
  555.                          ELSE writeln ( outfile );
  556.               IF (Options AND ofFramed)=ofFramed THEN
  557.                 BEGIN
  558.                   LO.X := DBOrig.X+Origin.X-1;
  559.                   LO.Y := DBOrig.Y+Origin.Y-1;
  560.                   SI.X := Size.X+2; SI.Y := Size.Y+2;
  561.                   PutFrame ( LO, SI, nil);
  562.                 END;
  563.               LO.X := DBOrig.X+Origin.X;
  564.               LO.Y := DBOrig.Y+Origin.Y;
  565.               PutFrame ( LO, Size, nil);
  566.               IF VScrollBar<>NIL THEN
  567.                 BEGIN
  568.                   BO.X := DBOrig.X+VScrollBar^.Origin.X;
  569.                   BO.Y := DBOrig.Y+VScrollBar^.Origin.Y;
  570.                   PutBar(BO,VScrollBar^.Size);
  571.                 END;
  572.               IF HScrollBar<>NIL THEN
  573.                 BEGIN
  574.                   BO.X := DBOrig.X+HScrollBar^.Origin.X;
  575.                   BO.Y := DBOrig.Y+HScrollBar^.Origin.Y;
  576.                   PutBar(BO,HScrollBar^.Size);
  577.                 END;
  578.             END;
  579.       END;
  580.  
  581.     PROCEDURE WriteView ( P : PView ) ; far;
  582.       VAR i : integer; sh : String; VO : TPoint;
  583.       BEGIN
  584.         ownlabel := ownlabel+1;
  585.         IF TypeOf(P^)=TypeOf(TView) THEN
  586.           WITH PView(P)^ DO
  587.             BEGIN
  588.               writeln ( outfile, ownlabel:3, ': ',
  589.                       '(', Origin.X:2, ',', Origin.Y:2, ') (',
  590.                       Size.X:2, ',', Size.Y:2, ') ', hex(options):6, '  ');
  591.               VO.X := DBOrig.X+Origin.X; VO.Y := DBOrig.Y+Origin.Y;
  592.               PutHatch ( VO, Size );
  593.             END;
  594.       END;
  595.  
  596.     {-------------------------------------}
  597.     FUNCTION CheckLabel ( P:PView) : boolean; far;
  598.       BEGIN
  599.         CheckLabel := TypeOF(P^) = TypeOf(TLabel);
  600.       END;
  601.  
  602.     FUNCTION CheckButton ( P:PView) : boolean; far;
  603.       BEGIN
  604.         CheckButton := TypeOF(P^) = TypeOf(TButton);
  605.       END;
  606.  
  607.     FUNCTION CheckRadioButtons ( P:PView) : boolean; far;
  608.       BEGIN
  609.         CheckRadioButtons := TypeOF(P^) = TypeOf(TRadioButtons);
  610.       END;
  611.  
  612.     FUNCTION CheckCheckBoxes ( P:PView) : boolean; far;
  613.       BEGIN
  614.         CheckCheckBoxes := TypeOF(P^) = TypeOf(TCheckBoxes);
  615.       END;
  616.  
  617.     FUNCTION CheckStaticText ( P:PView) : boolean; far;
  618.       BEGIN
  619.         CheckStaticText := TypeOF(P^) = TypeOf(TStaticText);
  620.       END;
  621.  
  622.     FUNCTION CheckParamText ( P:PView) : boolean; far;
  623.       BEGIN
  624.         CheckParamText := TypeOF(P^) = TypeOf(TParamText);
  625.       END;
  626.  
  627.     FUNCTION CheckInputLine ( P:PView) : boolean; far;
  628.       BEGIN
  629.         CheckInputLine := TypeOF(P^) = TypeOf(TInputLine);
  630.       END;
  631.  
  632.     FUNCTION CheckListViewer ( P:PView) : boolean; far;
  633.       BEGIN
  634.         CheckListViewer := TypeOF(P^) = TypeOf(TListViewer);
  635.       END;
  636.  
  637.     FUNCTION CheckListBox ( P:PView) : boolean; far;
  638.       BEGIN
  639.         CheckListBox := TypeOF(P^) = TypeOf(TListBox);
  640.       END;
  641.  
  642.     FUNCTION CheckSortedListBox ( P:PView) : boolean; far;
  643.       BEGIN
  644.         CheckSortedListBox := TypeOF(P^) = TypeOf(TSortedListBox);
  645.       END;
  646.  
  647.     FUNCTION CheckHistory ( P:PView) : boolean; far;
  648.       BEGIN
  649.         CheckHistory := TypeOF(P^) = TypeOf(THistory);
  650.       END;
  651.  
  652.     FUNCTION CheckView ( P:PView) : boolean; far;
  653.       BEGIN
  654.         CheckView := TypeOF(P^) = TypeOf(TView);
  655.       END;
  656.  
  657.     BEGIN {main processdialogb}
  658.       WITH DB^ DO
  659.         BEGIN
  660.           DBOrig := Origin; DBSize := Size;
  661.           IF Title<>NIL THEN writeln ( outfile,  '  ', Title^, '              ' );
  662.           writeln ( outfile,  '  Orig:(', Origin.X:2, ',', Origin.Y:2,
  663.                     '), Size:(', Size.X:2, ',',  Size.Y:2, ')',
  664.                     ', hcxxxx:', HelpCtx:5,
  665.                     ', Options:', Hex(Options):5,
  666.                     ', Flags:', hex(flags):5   );
  667.         END;
  668.  
  669.       FOR i := 0 TO 80 DO Screen[0,i] := ' ' ;
  670.       FOR i := 1 TO 25 DO Screen[i] := Screen[0];
  671.       writeln ( outfile );
  672.       PutFrame(DBOrig,DBSize, DB^.Title);
  673.  
  674.       IF DB^.FirstThat(@CheckButton)<>NIL THEN
  675.         BEGIN
  676.           ownlabel := 0;
  677.           writeln ( outfile,  '  [TButton]'); writeln ( outfile );
  678.           writeln ( outfile,
  679.           '  Z: Origin    Size  cmxxx hcxxx Flags Options Title' );
  680.           DB^.ForEach(@WriteButton);
  681.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  682.         END;
  683.  
  684.       IF DB^.FirstThat(@CheckInputLine)<>NIL THEN
  685.         BEGIN
  686.           ownlabel := 0;
  687.           writeln ( outfile,  '  [TInputLine]'); writeln ( outfile );
  688.           writeln ( outfile,
  689.           '  Z: Origin    Size  hcxxx Options AMaxLen Label History' );
  690.           DB^.ForEach(@WriteInputLine);
  691.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  692.         END;
  693.  
  694.       IF DB^.FirstThat(@CheckListViewer)<>NIL THEN
  695.         BEGIN
  696.           ownlabel := 0;
  697.           writeln ( outfile,  '  [TListViewer]'); writeln ( outfile );
  698.           writeln ( outfile,
  699.           '  Z: Origin    Size  hcxxx Options ScrollB Label' );
  700.           TypeOfDesc := TypeOf(TListViewer);
  701.           DB^.ForEach(@WriteListViewer);
  702.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  703.         END;
  704.  
  705.       IF DB^.FirstThat(@CheckListBox)<>NIL THEN
  706.         BEGIN
  707.           ownlabel := 0;
  708.           writeln ( outfile,  '  [TListBox]'); writeln ( outfile );
  709.           writeln ( outfile,
  710.           '  Z: Origin    Size  hcxxx Options ScrollB Label' );
  711.           TypeOfDesc := TypeOf(TListBox);
  712.           DB^.ForEach(@WriteListViewer);
  713.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  714.         END;
  715.  
  716.       IF DB^.FirstThat(@CheckSortedListBox)<>NIL THEN
  717.         BEGIN
  718.           ownlabel := 0;
  719.           writeln ( outfile,  '  [TSortedListBox]'); writeln ( outfile );
  720.           writeln ( outfile,
  721.           '  Z: Origin    Size  hcxxx Options ScrollB Label' );
  722.           TypeOfDesc := TypeOf(TSortedListBox);
  723.           DB^.ForEach(@WriteListViewer);
  724.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  725.         END;
  726.  
  727.       IF DB^.FirstThat(@CheckRadioButtons)<>NIL THEN
  728.         BEGIN
  729.           ownlabel := 0;
  730.           writeln ( outfile,  '  [TRadioButtons]'); writeln ( outfile );
  731.           writeln ( outfile,
  732.           '  Z: Origin    Size  hcxxx Options Value Label Items' );
  733.           DB^.ForEach(@WriteRadioButtons);
  734.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  735.         END;
  736.  
  737.       IF DB^.FirstThat(@CheckCheckBoxes)<>NIL THEN
  738.         BEGIN
  739.           ownlabel := 0;
  740.           writeln ( outfile,  '  [TCheckBoxes]'); writeln ( outfile );
  741.           writeln ( outfile,
  742.           '  Z: Origin    Size  hcxxx Options Value Label Items' );
  743.           DB^.ForEach(@WriteCheckBoxes);
  744.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  745.         END;
  746.  
  747.       IF DB^.FirstThat(@CheckHistory)<>NIL THEN
  748.         BEGIN
  749.           ownlabel := 0;
  750.           writeln ( outfile,  '  [THistory]'); writeln ( outfile );
  751.           writeln ( outfile,  '  Z: Origin    Size  Options HistID Link' );
  752.           DB^.ForEach(@WriteHistory);
  753.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  754.         END;
  755.  
  756.       IF DB^.FirstThat(@CheckView)<>NIL THEN
  757.         BEGIN
  758.           ownlabel := 0;
  759.           writeln ( outfile,  '  [TView]'); writeln ( outfile );
  760.           writeln ( outfile,  '  Z: Origin    Size  Options' );
  761.           DB^.ForEach(@WriteView);
  762.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  763.         END;
  764.  
  765.       {must be last to write over frames}
  766.       IF DB^.FirstThat(@CheckStaticText)<>NIL THEN
  767.         BEGIN
  768.           ownlabel := 0;
  769.           writeln ( outfile,  '  [TStaticText]'); writeln ( outfile );
  770.           writeln ( outfile,  '  Z: Origin    Size  Options Text' );
  771.           DB^.ForEach(@WriteStaticText);
  772.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  773.         END;
  774.  
  775.       IF DB^.FirstThat(@CheckParamText)<>NIL THEN
  776.         BEGIN
  777.           ownlabel := 0;
  778.           writeln ( outfile,  '  [TParamText]'); writeln ( outfile );
  779.           writeln ( outfile,  '  Z: Origin    Size  Options Count Text' );
  780.           DB^.ForEach(@WriteParamText);
  781.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  782.         END;
  783.  
  784.       IF DB^.FirstThat(@CheckLabel)<>NIL THEN
  785.         BEGIN
  786.           ownlabel := 0;
  787.           writeln ( outfile,  '  [TLabel]'); writeln ( outfile );
  788.           writeln ( outfile,  '  Z: Origin    Size  Options Link Text' );
  789.           DB^.ForEach(@WriteLabel);
  790.           writeln ( outfile,  '  ---------------------'); writeln ( outfile );
  791.         END;
  792.  
  793.       writeln ( outfile );
  794.       FOR i := DBOrig.Y TO DBOrig.Y+DBSize.Y DO
  795.         BEGIN
  796.           FOR j := 0 TO 80 DO
  797.             write ( outfile,  Screen[i,j]) ;
  798.           writeln ( outfile );
  799.         END;
  800.       writeln ( outfile );
  801.  
  802.     END; {PROC ProcessDialogB}
  803.  
  804.  
  805.   PROCEDURE DoIt(Key:String;MyObj:PObject;
  806.                  StreamStatus,StreamInfo:integer);
  807.   {nonlocal MyObj}
  808.     VAR w,max : word;
  809.         err : integer;
  810.         SL : PStringList;
  811.         s35 : String[35];
  812.         s15 : String[15];
  813.         Typ : String;
  814.         STDef : PStatusDef; STItem : PStatusItem;
  815.  
  816.      PROCEDURE PrintPMI( PMI:PMenuItem; level : integer );
  817.        VAR s40 : String[40];
  818.            s15 : String[15];
  819.            i : integer;
  820.            cmd, hcxxxx : word;
  821.        BEGIN
  822.          WHILE PMI<>NIL DO
  823.            BEGIN
  824.              WITH PMI^ DO
  825.                BEGIN
  826.                  s40 := '';
  827.                  FOR i := 1 TO (2*level) DO s40 := s40 + ' ';
  828.                  IF Name<>NIL
  829.                    THEN
  830.                      BEGIN
  831.                        s40 := s40 + Name^;
  832.                        cmd := command; hcxxxx := HelpCtx
  833.                      END
  834.                    ELSE
  835.                      BEGIN {command and HelpCtx are undefined !}
  836.                        s40 := s40 + '──────────────────';
  837.                        cmd := 0; hcxxxx := 0
  838.                      END;
  839.                  s40 := s40 + '                                        ';
  840.                  IF KeyCode<>0 THEN s15 := KeyName(KeyCode) ELSE s15 := '';
  841.                  s15 := s15 + '               ';
  842.                  writeln ( outfile,  s40, '  ', s15, '  ',
  843.                            cmd:5, '    ', hcxxxx:5 );
  844.                  IF (command=0) AND (name<>nil) AND (SubMenu<>nil) THEN
  845.                     PrintPMI(SubMenu^.Items,level+1);
  846.                END; {WITH PMI^ ... }
  847.              PMI := PMI^.NEXT;
  848.            END;
  849.        END; {PROC PrintPMI}
  850.  
  851.     BEGIN
  852.       Typ := '';
  853.       IF TypeOf(MyObj^)=TOM  THEN Typ := '[TMenubar]';
  854.       IF TypeOf(MyObj^)=TOD  THEN Typ := '[TDialog]';
  855.       IF TypeOf(MyObj^)=TOS  THEN Typ := '[TStringList]';
  856.       IF TypeOf(MyObj^)=TOSL THEN Typ := '[TStatusline]';
  857.       s35 := Key+'                              ';
  858.  
  859.       IF Typ='' THEN
  860.         BEGIN
  861.           writeln ( outfile, 'Cannot handle object "', key, '".' );
  862.           writeln ( outfile, 'Subviews must be part of a TDialog object.');
  863.           writeln ( outfile );
  864.         END;
  865.       IF StreamStatus<>stok THEN
  866.         BEGIN
  867.           writeln ( outfile,
  868.       'Warning: Stream error occured while reading object "', Key, '".' );
  869.           write ( outfile, 'Status code: ', StreamStatus:4, ', ' );
  870.           IF StreamStatus=stGetError
  871.             THEN writeln ( outfile, 'unregistered ObjType: ', StreamInfo:4)
  872.             ELSE writeln ( outfile, 'DOS/EMS error code: ', StreamInfo:4 );
  873.           writeln ( outfile );
  874.         END;
  875.  
  876.      IF (Typ='[TStringList]') AND (DumpWhat IN ['A','S','F']) THEN
  877.        BEGIN
  878.           writeln ( outfile,  s35, Typ ); writeln ( outfile );
  879.           SL := PStringList(Resfile.Get(Key));
  880.           {RESEDIT stores highest key used at position 65535}
  881.           Val (SL^.Get(65535),max,err);
  882.           IF err<>0 THEN max := 65535;
  883.           FOR w := 0 TO max DO
  884.             BEGIN
  885.               s  := SL^.Get(w);
  886.               IF s<>'' THEN
  887.                 BEGIN
  888.                   write ( outfile,  w:5, '  ');
  889.                   WrapText( s, 7 );
  890.                 END;
  891.             END;
  892.           Dispose(SL, Done );
  893.        END;
  894.  
  895.      IF (Typ='[TDialog]') AND (DumpWhat IN ['A','D','F'])  THEN
  896.        BEGIN
  897.          writeln ( outfile,  s35, Typ ); writeln ( outfile );
  898.          DB := PDialog(MyObj);
  899.          ProcessDialogB (DB);
  900.        END;
  901.  
  902.      IF (Typ='[TStatusline]') AND (DumpWhat IN ['A','L','F'])  THEN
  903.        BEGIN
  904.          writeln ( outfile,  s35, Typ ); writeln ( outfile );
  905.          writeln ( outfile,
  906.          'hc range      Command   Key               Text');
  907.          writeln ( outfile );
  908.          STDef := PStatusLine(MyObj)^.Defs;
  909.          WHILE STDef<>NIL DO
  910.            BEGIN
  911.              write ( outfile, hex(STDef^.Min):5, '-', hex(STDef^.Max):5,
  912.                               ' :   ' );
  913.              STItem := STDef^.Items;
  914.              WHILE STItem<>NIL DO
  915.                BEGIN
  916.                  WITH STItem^ DO
  917.                    BEGIN
  918.                      s15 := '';
  919.                      IF keycode<>0 THEN s15 := Keyname(KeyCode);
  920.                      s15 := s15 + '               ';
  921.                      write ( outfile, command:5, '   ', s15, '   ' );
  922.                      IF Text<>NIL THEN write ( outfile, Text^ );
  923.                      writeln (outfile);
  924.                    END;
  925.                  STItem := STItem^.next;
  926.                  IF STItem<>NIL THEN write ( outfile, ' ':16);
  927.                END;
  928.              STDef := STDef^.Next;
  929.            END; {WHILE STDef<>NIL ...}
  930.        END;
  931.  
  932.      IF (Typ='[TMenubar]') AND (DumpWhat IN ['A','M','F']) THEN
  933.        BEGIN
  934.          writeln ( outfile,  s35, Typ ); writeln ( outfile );
  935.          MB := PMenuBar(MyObj);
  936.          PMI := MB^.Menu^.Items;
  937.          writeln ( outfile,
  938. 'Menuitem                                  KeyCode         cmxxxx   hcxxxx');
  939.          writeln ( outfile );
  940.          PrintPMI(PMI,0);
  941.        END;
  942.  
  943.       writeln ( outfile );
  944.       writeln ( outfile,
  945.               '----------------------------------------------------');
  946.       IF MyObj<>NIL THEN Dispose(MyObj,Done);
  947.  
  948.  
  949.     END; {PROC DoIt}
  950.  
  951.   PROCEDURE CheckStreamStatus ( VAR streamstatus, streaminfo : integer;
  952.                                 VAR StreamErrorOccured : boolean );
  953.     {check stream status, reset stream in case of error,
  954.      mark error in var StreamErrorOccured}
  955.     VAR stat : integer;
  956.     BEGIN
  957.       streaminfo := 0;
  958.       streamstatus := ResFile.Stream^.status;
  959.       IF (streamstatus<>stOk) THEN {unregistered object}
  960.         BEGIN
  961.           StreamErrorOccured := true;
  962.           streaminfo := ResFile.Stream^.ErrorInfo;
  963.           ResFile.Stream^.Reset; {resume stream operation}
  964.         END;
  965.     END; {CheckStreamStatus}
  966.  
  967. BEGIN {main}
  968.   TOM := TypeOf(TMenuBar);
  969.   TOD := TypeOf(TDialog);
  970.   TOS := TypeOf(TStringList);
  971.   TOSL:= TypeOf(TStatusLine);
  972.   StreamErrorOccured := false;
  973.  
  974.   IF DumpWhat='F' {focused item}
  975.     THEN
  976.       BEGIN
  977.         MyObj := ResFile.Get(ItemKey);
  978.         Key := ItemKey;
  979.         CheckStreamStatus(streamstatus,streaminfo,StreamErrorOccured);
  980.         DoIt(Key,MyObj,streamstatus,streaminfo);
  981.       END
  982.     ELSE
  983.       FOR i := 0 TO ResFile.Count-1 DO
  984.         BEGIN
  985.           Key := ResFile.KeyAt(i);
  986.           MyObj := ResFile.Get(Key); {delete later, }
  987.           CheckStreamStatus(streamstatus,streaminfo,StreamErrorOccured);
  988.           DoIt(Key,MyObj,streamstatus,streaminfo);
  989.         END; {FOR i := 0 TO ... }
  990.  
  991.   END; {PROC DumpIt}
  992.  
  993. END. {UNIT DResFU}
  994.  
  995.